home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / turbotut.arc / LIST.PAS < prev    next >
Pascal/Delphi Source File  |  1989-06-30  |  4KB  |  130 lines
  1. PROGRAM list_pascal_source_files;
  2.  
  3. CONST max_lines_per_page = 50;
  4.  
  5. TYPE command_string = STRING[127];
  6.  
  7.                    (* Note; This will not compile properly with
  8.                       TURBO Pascal 2.0. Change the definition of
  9.                       "input_line" to a STRING[140] if you are
  10.                       using TURBO Pascal 2.0, since READ and
  11.                       READLN do not work with ARRAY OF CHAR.  *)
  12.  
  13. VAR input_file      : TEXT;
  14.     input_line      : ARRAY[1..140] OF CHAR;
  15.     line_number     : INTEGER;
  16.     lines_printed   : INTEGER;
  17.     page_no         : INTEGER;
  18.     index           : INTEGER;
  19.     command_in      : command_string ABSOLUTE cseg:$80;
  20.     command_temp    : command_string;
  21.     command         : command_string;
  22.  
  23. PROCEDURE initialize; (* ****************************** initialize *)
  24. BEGIN
  25.   command := '';
  26.   command_temp := command_in;  (* leave the input area unchanged *)
  27.   WHILE (length(command_temp) > 0) AND (command_temp[1] = ' ') DO
  28.     delete(command_temp,1,1);
  29.   WHILE (length(command_temp) > 0) AND (command_temp[1] <> ' ') DO
  30.     BEGIN
  31.       command := command + command_temp[1];
  32.       delete(command_temp,1,1);
  33.     END;
  34.   ASSIGN(input_file,command);
  35.   RESET(input_file);
  36.   line_number := 1;
  37.   lines_printed := 66; (* This is to force a header immediately *)
  38.   page_no := 1;
  39. END;
  40.  
  41. PROCEDURE read_a_line; (* **************************** read a line *)
  42. BEGIN
  43.   FOR index := 1 TO 140 DO input_line[index] := ' ';
  44.   READLN(input_file,input_line);
  45. END;
  46.  
  47. PROCEDURE format_and_display; (* **************** format and display *)
  48.  
  49. VAR line_length : BYTE;
  50.  
  51. BEGIN
  52.   WRITE(line_number:6,'  ');
  53.     FOR index := 1 TO 140 DO
  54.     BEGIN
  55.       IF input_line[index] <> ' ' THEN line_length := index;
  56.     END;
  57.   IF line_length <= 70 THEN
  58.     BEGIN               (* line length less than 70 characters *)
  59.       FOR index := 1 TO line_length DO
  60.         WRITE(input_line[index]);
  61.       WRITELN;
  62.     END
  63.   ELSE
  64.     BEGIN               (* line length more than 70 characters *)
  65.       FOR index := 1 TO 70 DO
  66.         WRITE(input_line[index]);
  67.       WRITELN('<');
  68.       WRITE('        ');
  69.       FOR index := 71 TO line_length DO
  70.         WRITE(input_line[index]);
  71.       WRITELN;
  72.     END;
  73. END;
  74.  
  75. PROCEDURE format_and_print; (* ****************** format and print *)
  76.  
  77. VAR line_length : BYTE;
  78.  
  79. BEGIN
  80.   WRITE(lst,line_number:6,'  ');
  81.     FOR index := 1 TO 140 DO
  82.     BEGIN
  83.       IF input_line[index] <> ' ' THEN line_length := index;
  84.     END;
  85.   IF line_length <= 70 THEN
  86.     BEGIN               (* line length less than 70 characters *)
  87.       FOR index := 1 TO line_length DO
  88.         WRITE(lst,input_line[index]);
  89.       WRITELN(lst);
  90.       lines_printed := lines_printed + 1;
  91.     END
  92.   ELSE
  93.     BEGIN               (* line length more than 70 characters *)
  94.       FOR index := 1 TO 70 DO
  95.         WRITE(lst,input_line[index]);
  96.       WRITELN(lst,'<');
  97.       WRITE(lst,'        ');
  98.       FOR index := 71 TO line_length DO
  99.         WRITE(lst,input_line[index]);
  100.       WRITELN(lst);
  101.       lines_printed := lines_printed + 2;
  102.     END;
  103.   line_number := line_number + 1;
  104. END;
  105.  
  106. PROCEDURE check_for_page; (* ********************** check for page *)
  107. BEGIN
  108.   IF lines_printed > Max_lines_per_page THEN
  109.   BEGIN
  110.     IF page_no > 1 THEN WRITELN(lst,char(12));
  111.     FOR index := 1 TO 3 DO WRITELN(lst);
  112.     WRITE(lst,'     ');
  113.     WRITELN(lst,'Source file ',command,'Page':24,page_no:4);
  114.     page_no := page_no + 1;
  115.     lines_printed := 1;
  116.     WRITELN(lst);
  117.   END;
  118. END;
  119.  
  120. BEGIN  (* ******************************************* main program *)
  121.   initialize;
  122.   check_for_page;
  123.   REPEAT
  124.     read_a_line;
  125.     format_and_display;
  126.     format_and_print;
  127.     check_for_page;
  128.   UNTIL eof(input_file);
  129.   WRITELN(lst,char(12));
  130. END.  (* of main program *)